home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / spin.cls < prev    next >
Encoding:
Visual Basic class definition  |  1998-12-19  |  7.5 KB  |  292 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Spin"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
  11. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  12. Private rChangeRate As Long
  13. Private rEnabled As Boolean
  14. Private WithEvents Up As ComboPack.Button
  15. Attribute Up.VB_VarHelpID = -1
  16. Private WithEvents Down As ComboPack.Button
  17. Attribute Down.VB_VarHelpID = -1
  18. Private rForeColor As Long
  19. Private rBackColor As Long
  20. Private rLeft As Single
  21. Private rTop As Single
  22. Private rWidth As Single
  23. Private rHeight As Single
  24. Private rMinValue As Long
  25. Private rMaxValue As Long
  26. Private rValue As Long
  27. Public Parent As Object
  28. Public Event Click()
  29. Public Event Resize()
  30. Public Event Changed(PropertyName As String)
  31. Public Event PositionChange(NewLeft As Single, _
  32. NewTop As Single)
  33. Public Event MouseDown(Button As Integer, X As _
  34.     Single, Y As Single)
  35. Public Event MouseMove(Button As Integer, X As _
  36.     Single, Y As Single)
  37. Public Event MouseUp(Button As Integer, X As _
  38.     Single, Y As Single)
  39. Public Property Let MaxValue(ByVal vData As Long)
  40.     rMaxValue = vData
  41. End Property
  42. Public Property Get MaxValue() As Long
  43.     MaxValue = rMaxValue
  44. End Property
  45. Public Property Let MinValue(ByVal vValue As Long)
  46. Attribute MinValue.VB_Description = "Returns/sets the Minimum value that the object displays."
  47.     rMinValue = vValue
  48. End Property
  49. Public Property Get MinValue() As Long
  50.     MinValue = rMinValue
  51. End Property
  52. Public Property Let Height(ByVal vValue As Single)
  53.     rHeight = vValue
  54.     Changed "Size"
  55. End Property
  56. Public Property Get Height() As Single
  57.     Height = rHeight
  58. End Property
  59. Public Property Let Width(ByVal vValue As Single)
  60.     rWidth = vValue
  61.     Changed "Size"
  62. End Property
  63. Public Property Get Width() As Single
  64.     Width = rWidth
  65. End Property
  66.  
  67. Public Property Let Top(ByVal vValue As Single)
  68.     rTop = vValue
  69.     Changed "Position"
  70. End Property
  71.  
  72. Public Property Get Top() As Single
  73.     Top = rTop
  74. End Property
  75.  
  76. Public Property Let Left(ByVal vValue As Single)
  77.     rLeft = vValue
  78.     Changed "Position"
  79. End Property
  80. Public Property Get Left() As Single
  81.     Left = rLeft
  82. End Property
  83.  
  84. Public Property Get ForeColor() As Long
  85.     ForeColor = rForeColor
  86. End Property
  87. Public Property Let ForeColor(vForeColor As Long)
  88.     rForeColor = vForeColor
  89.     Changed "Color"
  90. End Property
  91. Public Sub Changed(Name As String)
  92. Select Case Name
  93.     Case "Size"
  94.         Redraw
  95.         ResizeControls
  96.         RaiseEvent Resize
  97.     Case "Position"
  98.         RaiseEvent PositionChange(Left, Top)
  99. End Select
  100. RaiseEvent Changed(Name)
  101. End Sub
  102. Public Sub MouseDown(Button As Integer, X As Single, Y As Single)
  103.     Up.MouseDown Button, X, Y
  104.     Down.MouseDown Button, X, Y
  105.     RaiseEvent MouseDown(Button, X - Left, Y - Top)
  106. End Sub
  107. Public Sub MouseMove(Button As Integer, X As Single, Y As Single)
  108.     Up.MouseMove Button, X, Y
  109.     Down.MouseMove Button, X, Y
  110.     RaiseEvent MouseMove(Button, X - Left, Y - Top)
  111. End Sub
  112. Public Sub MouseUp(Button As Integer, X As Single, Y As Single)
  113.     If InScope(X, Y) And Button = 1 Then
  114.         RaiseEvent Click
  115.     End If
  116.     Up.MouseUp Button, X, Y
  117.     Down.MouseUp Button, X, Y
  118.     RaiseEvent MouseUp(Button, X - Left, Y - Top)
  119. End Sub
  120.  
  121. Private Sub Class_Initialize()
  122.     BackColor = vbButtonFace
  123.     CreateControls
  124. End Sub
  125.  
  126. Private Sub Class_Terminate()
  127.     Set Up = Nothing
  128.     Set Down = Nothing
  129. End Sub
  130.  
  131. Public Sub Redraw()
  132.     Dim m_intDWid As Integer
  133.     On Error Resume Next
  134.     m_intDWid = Parent.DrawWidth
  135.     Parent.DrawWidth = 1
  136.     If Up Is Nothing Then
  137.         CreateControls
  138.         ResizeControls
  139.     End If
  140.     Up.BackColor = BackColor
  141.     Down.BackColor = BackColor
  142.     Set Down.Parent = Parent
  143.     Set Up.Parent = Parent
  144.     DrawBox Parent, Left, Top, Width - 280, Height, True, True, BackColor
  145.     Parent.CurrentX = Left + (Width - 700) - Parent.TextWidth(Value)
  146.     Parent.CurrentY = Top + (Height / 2 - Parent.TextHeight(Value) / 2)
  147.     Parent.Print Value
  148.     Up.Redraw
  149.     Down.Redraw
  150.     Parent.DrawWidth = m_intDWid
  151.     CheckEnable Value
  152. End Sub
  153.  
  154. Private Sub ResizeControls()
  155. On Error Resume Next
  156.     With Down
  157.         .Left = Left + Width - 300
  158.         .Top = Top
  159.         .Width = 300
  160.         .Height = Height
  161.         Set .Font = New StdFont
  162.         .Font.Size = Parent.Font.Size
  163.         .Font.Bold = Parent.Font.Bold
  164.         .Font.Italic = Parent.Font.Italic
  165.         .Font.Charset = Parent.Font.Charset
  166.         .Font.Strikethrough = Parent.Font.Strikethrough
  167.         .Font.Name = "Symbol"
  168.         .Caption = Chr(223)
  169.         .Enabled = Enabled
  170.     End With
  171.     With Up
  172.         .Left = Left + Width - 600
  173.         .Top = Top
  174.         .Width = 300
  175.         .Height = Height
  176.         Set .Font = New StdFont
  177.         .Font.Size = Parent.Font.Size
  178.         .Font.Bold = Parent.Font.Bold
  179.         .Font.Italic = Parent.Font.Italic
  180.         .Font.Charset = Parent.Font.Charset
  181.         .Font.Strikethrough = Parent.Font.Strikethrough
  182.         .Font.Name = "Symbol"
  183.         .Caption = Chr(221)
  184.         .Enabled = Enabled
  185.     End With
  186. End Sub
  187.  
  188. Private Sub CreateControls()
  189.     Set Down = New ComboPack.Button
  190.     Set Up = New ComboPack.Button
  191. End Sub
  192.  
  193. Public Sub Move(Left As Single, Optional Top As Single, Optional Width As Single, Optional Height As Single)
  194.     If Left > 0 Then Me.Left = Left
  195.     If Top > 0 Then Me.Top = Top
  196.     If Width > 0 Then Me.Width = Width
  197.     If Height > 0 Then Me.Height = Height
  198. End Sub
  199.  
  200. Public Property Get Enabled() As Boolean
  201.     Enabled = rEnabled
  202. End Property
  203.  
  204. Public Property Let Enabled(ByVal vEnabled As Boolean)
  205.     rEnabled = vEnabled
  206.     Changed "Enabled"
  207. End Property
  208.  
  209. Public Property Get Value() As Long
  210. Attribute Value.VB_UserMemId = 0
  211.     Value = rValue
  212. End Property
  213.  
  214. Public Property Let Value(ByVal vValue As Long)
  215.     CheckEnable vValue
  216.     rValue = vValue
  217.     Changed "Value"
  218.     Redraw
  219. End Property
  220. Public Property Get BackColor() As Long
  221.     BackColor = rBackColor
  222. End Property
  223. Public Property Let BackColor(ByVal vBackColor As Long)
  224.     rBackColor = vBackColor
  225.     Redraw
  226.     Changed "Color"
  227.     On Error Resume Next
  228.     Up.BackColor = vBackColor
  229.     Down.BackColor = vBackColor
  230. End Property
  231.  
  232. Public Property Get ChangeRate() As Long
  233. ChangeRate = rChangeRate
  234. End Property
  235.  
  236. Public Property Let ChangeRate(ByVal vChangeRate As Long)
  237. rChangeRate = vChangeRate
  238. Changed "Rate"
  239. End Property
  240.  
  241. Private Sub Down_Press()
  242. Static Press As Long
  243. Do Until Not Down.Pressed
  244. DoEvents
  245. Press = Press + 1
  246. If Press = 5000 Then
  247. Value = Value - ChangeRate
  248. Press = 0
  249. End If
  250. Loop
  251. Press = 0
  252. End Sub
  253.  
  254. Private Sub Up_Press()
  255. Static Press As Long
  256. Do Until Not Up.Pressed
  257. DoEvents
  258. Press = Press + 1
  259. If Press = 5000 Then
  260. Value = Value + ChangeRate
  261. Press = 0
  262. End If
  263. Loop
  264. Press = 0
  265. End Sub
  266. Public Function InScope(X As Single, Y As Single)
  267. 'Checks the X and Y of the event that calls it, _
  268. VERY Simple Function
  269. InScope = ((X - Left) > 0 And (X - Left) < Width) And ((Y - Top) > 0 And (Y - Top) < Height)
  270. End Function
  271.  
  272.  
  273.  
  274. Private Sub CheckEnable(vValue As Long)
  275.     If vValue <= MinValue Then
  276.         vValue = MinValue
  277.         Down.Enabled = False
  278.     Else
  279.         If Not Down.Enabled Then
  280.             Down.Enabled = True
  281.         End If
  282.     End If
  283.     If vValue >= MaxValue Then
  284.         vValue = MaxValue
  285.         Up.Enabled = False
  286.     Else
  287.         If Not Up.Enabled Then
  288.             Up.Enabled = True
  289.         End If
  290.     End If
  291. End Sub
  292.